home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swagg_m.zip / MISC.SWG / 0098_Amortization Routine.pas < prev    next >
Pascal/Delphi Source File  |  1994-05-26  |  4KB  |  126 lines
  1. program amort;
  2.  
  3. { This program does a good job of loan amortization. The original
  4.   author is unknown. I added a procedure to exit the program without
  5.   showing all years for amortization. Richard Odom..VA Beach        }
  6.  
  7. const
  8.   MonthTab = 8; {month column}
  9.   PayTab = 14;  {payment column}
  10.   PrinTab = 28; {principle column}
  11.   IntTab = 41;  {interest column}
  12.   BalTab = 53;  {balance column}
  13.  
  14.  
  15. var
  16.   balance, payment, interest, rate, years,
  17.   i1, i2, CurrInt, CurrPrin, ypay, yint, yprin,
  18.   GTPay, GTInt, GTPrin:                            real;
  19.   year, month, line:                            integer;
  20.   borrower:                                  string[32];
  21.   response:                                        char;
  22.  
  23.  
  24.  
  25.  
  26. begin
  27.   repeat
  28.  
  29.     ClrScr;
  30.     write ('Name of borrower: ');
  31.     readln (borrower);
  32.     write ('Amount of loan: ');
  33.     readln (balance);
  34.     write ('Interest rate: ');
  35.     readln (interest);
  36.     i1 := interest/1200 {monthly interest};
  37.     write ('Do you know the monthly payments? ');
  38.     readln (response);
  39.  
  40.     if UpCase(response) = 'Y'
  41.       then begin
  42.         write ('Payment amount: ');
  43.         readln (payment);
  44.       end
  45.       else begin
  46.         write ('Number of years: ');
  47.         readln (years);
  48.         i2 := exp(ln(i1 + 1) * (12 * years));
  49.         payment := balance * i1 * i2 / (i2 - 1);
  50.         payment := int(payment * 100 + 0.5) / 100;
  51.         writeln ('The monthly payment is $',payment:4:2,'.')
  52.       end;
  53.  
  54.     write ('Starting year for loan: ');
  55.     readln (year);
  56.     write ('Starting month for loan: ');
  57.     readln (month);
  58.     write ('Press <RETURN> to see monthly totals.');
  59.     readln (response);
  60.     ClrScr; line := 6;
  61.     writeln ('Loan for ',borrower);
  62.     writeln (' Loan of $',balance:4:2,' at ',interest:4:2,'% interest.');
  63.     writeln (' Fixed monthly payments of $',payment:4:2,'.');
  64.     writeln;
  65.     writeln (year:4,'  Month     Payment     Principle     Interest       Balance');
  66.     ypay := 0; yprin := 0; yint := 0;
  67.     GTPay := 0; GTInt := 0; GTPrin := 0; {initialize totals}
  68.  
  69.     while balance>0 do begin
  70.       CurrInt := int(100 * i1 * balance +0.5) / 100;
  71.       CurrPrin := payment - CurrInt;
  72.  
  73.       if CurrPrin>balance then begin
  74.         CurrPrin := balance;
  75.         payment := CurrInt + CurrPrin;
  76.       end;
  77.  
  78.       balance := balance - CurrPrin;
  79.       ypay := ypay + payment; yint := yint + CurrInt; yprin := yprin + CurrPrin;
  80.       GTPay := GTPay + payment; GTInt := GTInt + CurrInt; GTPrin := GTPrin + CurrPrin;
  81.       line := line + 1; GotoXY(MonthTab,line);
  82.       write (month:2); GotoXY(PayTab,line);
  83.       write (payment:10:2); GotoXY(PrinTab,line);
  84.       write (CurrPrin:10:2); GotoXY(IntTab,line);
  85.       write (CurrInt:10:2); GotoXY(BalTab,line);
  86.       writeln (balance:12:2);
  87.       month := month + 1;
  88.  
  89.       if (month>12) or (balance=0.0) then begin
  90.         writeln; line := line + 2;
  91.         write (year:4,' Total'); GotoXY(PayTab,line);
  92.         write (ypay:10:2); GotoXY(PrinTab,line);
  93.         write (yprin:10:2); GotoXY(IntTab,line);
  94.         write (yint:10:2); GotoXY(BalTab,line);
  95.         writeln (balance:12:2);
  96.         year := year + 1;
  97.         month := 1;
  98.         ypay := 0; yprin := 0; yint := 0;
  99.  
  100.         if balance>0 then begin
  101.           writeln;
  102.           writeln ('Press <RETURN> to see ',year:4,'.');
  103.           write('Enter Q to end program  ');
  104.           readln (response);
  105.           If upcase(response)='Q' then
  106.            halt;
  107.           ClrScr; line := 2; writeln (year:4,'  Month     Payment     Principle     Interest       Balance');
  108.         end;
  109.  
  110.       end;
  111.  
  112.     end; {while}
  113.  
  114.     writeln; line := line + 2;
  115.     write ('Grand Total'); GotoXY(PayTab,line);
  116.     write (GTPay:10:2); GotoXY(PrinTab,line);
  117.     write (GTPrin:10:2); GotoXY(IntTab,line);
  118.     write (GTInt:10:2); GotoXY(BalTab,line);
  119.     writeln (balance:12:2);
  120.     writeln;
  121.     write ('Do you wish to start over? ');
  122.     readln (response);
  123.  
  124.   until UpCase(response)='N';
  125.  
  126. end.